{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

module Trie where

import qualified AList as A
import qualified AssoziativArray.Class as AA

data Trie a = NewTrie {childs ::  A.AList (Trie a) , payload :: Maybe a }

empty :: Trie a
empty = NewTrie [] Nothing

insert :: String -> a -> Trie a -> Trie a
insert (key:keys) insertValue (NewTrie [] Nothing) = 
        NewTrie (A.put [] key (insert keys insertValue empty)) Nothing
insert "" insertValue (NewTrie children _) =
        NewTrie children (Just insertValue)
insert (key:keys) insertValue (NewTrie children nodeValue) =
        if A.isIn children key then
                NewTrie (A.put children key (insert keys insertValue (A.get1 children key))) nodeValue
        else  
                NewTrie (A.put children key (insert keys insertValue empty)) nodeValue

lkup :: String -> Trie a -> Maybe a
lkup "" (NewTrie _ value) = 
        value
lkup (key:keys) (NewTrie children _) =
        if (A.isIn children key) then
                lkup keys (A.get1 children key)
        else
                Nothing

remove :: String -> Trie a -> Trie a
remove "" (NewTrie clds Nothing ) = NewTrie clds Nothing 
remove "" (NewTrie list (Just _)) = NewTrie list Nothing
remove (c:cs) orgTrie@(NewTrie clds a) = 
                if A.isIn clds c then
                    case remove cs (A.get1 clds c) of
                        NewTrie [] Nothing ->  NewTrie (A.del clds c) a
                        t -> NewTrie (A.put (A.del clds c) c t) a
                else
                    orgTrie
                    
-- ------------------------------- Aufgabe 2.3 --------------------------------------------------
mapT :: (a -> b) -> Trie a -> Trie b
mapT mappingFun trie =
        mapTK  (\_ -> mappingFun)  trie  
      
mapTK :: (String -> a -> b) -> Trie a -> Trie b
mapTK fun trie = 
        mapTKHelper fun trie ""
        
mapTKHelper :: (String -> a -> b) -> Trie a -> String -> Trie b

mapTKHelper (mappingFun) (NewTrie [] nodeValue) key = 
        NewTrie [] (getMappedValue mappingFun nodeValue key)
                 
mapTKHelper (mappingFun) (NewTrie ((key,childTrie):remainingChildren) nodeValue) completeKey =
        let
                firstChildTrie = mapTKHelper mappingFun childTrie (completeKey ++ [key])
                (NewTrie followingChildren _) = mapTKHelper mappingFun (NewTrie remainingChildren (nodeValue)) completeKey
        in
                NewTrie (A.put followingChildren key firstChildTrie) (getMappedValue mappingFun nodeValue completeKey)

getMappedValue :: (String -> a -> b) -> Maybe a -> String -> Maybe b
getMappedValue _ Nothing _ = 
        Nothing
        
getMappedValue fun (Just something) key =
        Just (fun key something)
 
-- ----------------------------------------------

filterT :: ( a -> Bool) -> Trie a -> Trie a
filterT filterFun trie = 
        filterTK (\_ -> filterFun)  trie  

filterTK :: (String -> a -> Bool) -> Trie a -> Trie a
filterTK filterFun trie = 
        filterTKHelper filterFun trie ""          

-- Blattknoten
filterTKHelper :: (String -> a -> Bool) -> Trie a -> String -> Trie a
filterTKHelper (filterFun) (NewTrie [] nodeValue) key = 
        let 
                newValue = getFilteredValue filterFun nodeValue key
        in
                NewTrie [] newValue

-- rechtes Kind
filterTKHelper (filterFun) (NewTrie ((key,childTrie):[]) nodeValue) completeKey =
        let 
                newChildTrie = filterTKHelper (filterFun) (childTrie) (completeKey ++ [key])
                newValue = getFilteredValue filterFun nodeValue completeKey
        in
                case  newChildTrie of
                (NewTrie [] Nothing)  -> NewTrie [] newValue     
                (NewTrie _ _)         -> NewTrie ((key,newChildTrie):[]) newValue
        
-- linkes/mittleres Kind
filterTKHelper (filterFun) (NewTrie ((key,firstChildTrie):remainingChildren) nodeValue) completeKey =
        let
                newFirstChildTrie = filterTKHelper filterFun firstChildTrie (completeKey ++ [key])
--                newValue = getFilteredValue filterFun nodeValue completeKey
                (NewTrie followingChildren newValue) = filterTKHelper filterFun (NewTrie remainingChildren (nodeValue)) completeKey
        in
                case  newFirstChildTrie of
                (NewTrie [] Nothing)  ->  NewTrie followingChildren newValue   
                (NewTrie _ _)         ->  NewTrie ((key, newFirstChildTrie) : followingChildren) (newValue)
               

getFilteredValue :: (String -> a -> Bool) -> Maybe a -> String -> Maybe a
getFilteredValue _ Nothing _ = 
        Nothing
getFilteredValue fun (Just something) key =
        case fun key something 
        of
                True -> Just something
                False -> Nothing
                
-- ----------------------------------------------

foldT :: ( a -> b -> b) -> b -> Trie a -> b
foldT foldFun startValue trie = 
        foldTK (\_ -> foldFun) startValue trie    
        
foldTK :: (String -> a -> b -> b) -> b -> Trie a -> b

foldTK fun startValue trie =
        foldTKHelper fun startValue trie ""  

foldTKHelper :: (String -> a -> b -> b) -> b -> Trie a -> String -> b
        
foldTKHelper (foldFun) tempResult (NewTrie [] (Just nodeValue)) key =
        foldFun key nodeValue tempResult
        
foldTKHelper (foldFun) tempResult (NewTrie ((key,firstChildTrie):[]) nodeValue) completeKey =
        let 
                childValue = foldTKHelper foldFun tempResult firstChildTrie (completeKey ++ [key]) 
        in
        case nodeValue
        of
                Nothing -> childValue
                Just x -> foldFun completeKey x childValue 
    
foldTKHelper (foldFun) tempResult (NewTrie ((key,firstChildTrie):remainingChildren) nodeValue) completeKey =
        let 
                newTempResult = foldTKHelper foldFun tempResult firstChildTrie (completeKey ++ [key]) 
                foldedChildResult = foldTKHelper (foldFun) newTempResult (NewTrie (remainingChildren) nodeValue) completeKey
        in
                foldedChildResult

-- ------------------------------------------------------------------------------------------------------------
insertTrie :: Trie a -> Trie a -> Trie a
insertTrie orgTrie addTrie =
        insertTrieHelper orgTrie (asList addTrie) --direkt mit foldTK
        
        
insertTrieHelper :: Trie a -> [(String, a)] -> Trie a
insertTrieHelper trie [] =
        trie
insertTrieHelper trie ((key, value):remainingList) =
        insertTrieHelper (insert key value trie) remainingList       

asList :: Trie a -> [(String, a)]
asList trie = 
        foldTK (\key trieValue array -> (key, trieValue):array ) [] trie

fromList :: [(String, a)] -> Trie a
fromList list =
        fromListHelper list empty -- mit listenfold

fromListHelper :: [(String, a)] -> Trie a -> Trie a 
fromListHelper [] trie =
        trie
fromListHelper ((key, value):remainingList) trie =
       fromListHelper remainingList (insert key value trie)


instance Show a => Show (Trie a) where
        show = toString
        
toString :: Show a => Trie a -> String
toString (NewTrie clds value) = "( " ++ show clds ++ " ; " ++ show value ++" )"

instance AA.AssoziativArray Trie a where
  memberOfAA key array       = case lkup key array of
                                        Nothing -> False
                                        Just _  -> True
  emptyAA                    = empty
  insertInAA key value array = insert key value array
  getFromAA key array        = lkup key array
  aaWithout array key        = remove key array
  aaIsEmpty array            = case  array of
                                        (NewTrie [] Nothing)  ->  True  
                                        (NewTrie _ _)         ->  False
 
